perm filename INIO.FAI[NEW,LCS] blob sn#592303 filedate 1981-06-06 generic text, type T, neo UTF8
00100		TITLE INIO ; 
00500		INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
00600	; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
00700		ENTRY TYPWRD,TYPSTR,TYPINT,TYPCRLF,TYPFLT,TYPCHR
00800	;TYPES A WORD, STRING, CRLF, INTEGER, FLTING PT., TYPE CHAR STRING(WD CNT)
00900	
01000	
01100		CH3←13		;USED WITH GETFI2, LOOKL
01200		CH1←15		;USED WITH ALL 'LOOK' ROUTINES
01300		CH←12		;USED WITH EXTIN
01400		CH2←11		;USED WITH EXTOUT
01500		BLKS←←=1
01600	
02500	
02600	
02700	DEFINE ERROR (MSG)
02800	<	JSA 16,.ERROR
02900		JUMP [ASCIZ/MSG/
03000	]
03100	>
03200	
03300	
03400	REGS:	BLOCK 20
03500	DIR:	BLOCK 4
03600	
03700	;CALL PUTEXT(<FILE>,<EXT>)
03800	PUTEXT:	0	;USES EXTOUT,FINEXT, CH2
03900		MOVE 0,@0(16)
04000		MOVEM 0,FILNAM
04100		MOVE 0,@1(16)
04200		MOVEM 0,EXTNAM
04300		PUSHJ 17,INTFIL
04400		SETZM DIR+2
04500		SETZM DIR+3
04600		ENTER CH2,DIR
04700		ERROR <ENTER FAILED>
04800		JRA 16,2(16)
04900	
05000	;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
05100	
05200	EXTOUT:	0
05300		MOVEI 0,@(16)
05400		SUBI 0,1
05500		MOVEM 0,COM
05600		MOVN 0,@1(16)
05700		HRLM 0,COM
05800		OUTPUT CH2,COM
05900		STATZ CH2,740000
06000		ERROR <WRITE ERROR>
06100		JRA 16,2(16)
06200	
06300	
06400	INTFIL:	MOVEI REGS	; INITS DSK
06500		BLT REGS+3
06600		INIT CH2,17
06700		SIXBIT/DSK/
06800		0
06900		ERROR <CAN'T INIT DSK!>
07000	INTF4:	MOVE 0,FILNAM#
07100		MOVEM 0,FN#
07200		MOVE 1,[POINT 7,FN]
07300	INTF3:	MOVE 2,[POINT 6,DIR]
07400		SETZM DIR
07500		MOVEI 3,5
07600	INTF1:	ILDB 0,1
07700		CAIN 0," "
07800		JRST INTF2
07900		SUBI 0,40
08000		IDPB 0,2
08100		SOJG 3,INTF1
08200	INTF2:	HRLZI REGS
08300		BLT 3
08400		MOVE 0,EXTNAM#
08500		MOVEM 0,EX#
08600		MOVE 1,[POINT 7,EX]
08700	EXTF3:	MOVE 2,[POINT 6,DIR+1]
08800		SETZM DIR+1
08900		MOVEI 3,5
09000	EXTF1:	ILDB 0,1
09100		CAIN 0," "
09200		JRST EXTF2
09300		SUBI 0,40
09400		IDPB 0,2
09500		SOJG 3,EXTF1
09600	EXTF2:	HRLZI REGS
09700		BLT 3
09800		POPJ 17,
09900	
10000	
10100	COM:	OCT 0,0
10200	BLKNUM:	0
10300	
10400	;CALL FINEXT
10500	FINEXT:	0
10600		CLOSE CH2,0
10700		STATZ CH2,740000
10800		ERROR <ERROR AFTER CLOSE>
10900		RELEASE CH2,0
11000		JRA 16,0(16)
11100	
11200	;CALL GETEXT(<FILE>,<EXT>)
11300	
11400	GETEXT:	0		;USES CH
11500		SETZM GETCH#	;FLAG TO USE CH
11600		MOVE 0,@0(16)
11700		MOVEM 0,FILNAM
11800		MOVE 0,@1(16)
11900		MOVEM 0,EXTNAM
12000		PUSHJ 17,INTFX
12100		SETZM DIR+3
12200		SETZM DIR+2
12300		LOOKUP CH,DIR
12400		ERROR <LOOKUP FAILED>
12500		JRA 16,2(16)
12600	
12700	INTFX:	PUSHJ 17,INITCH
12800		JRST INTF4
12900	
13000	INITCH:	MOVEI REGS	;INITS DSK FOR INPUT
13100		BLT REGS+3
13200		SKIPE GETCH	;SKIP IF DOING GETEXT
13300		JRST GETLK
13400		INIT CH,17
13500		SIXBIT/DSK/
13600		0
13700		ERROR <CAN'T INIT DSK!>
13800		POPJ 17,  
13900	GETLK:	INIT CH1,17
14000		SIXBIT/DSK/
14100		0
14200		ERROR <CAN'T INIT DSK!>
14300		POPJ 17,  
14400	
14500	
14600	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
14700	
14800	EXTIN:	0
14900		MOVEI 0,@(16)
15000		SUBI 0,1
15100		MOVEM 0,COM
15200		MOVN 0,@1(16)
15300		HRLM 0,COM
15400		INPUT CH,COM
15500		STATZ CH,740000
15600		0
15700		JRA 16,2(16)
15800	.ERROR:	0
15900		OUTSTR [ASCIZ/?
16000	/]				;MAKE SURE HE CAN SEE HIS ERROR
16100		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
16200		CALLI 1,12		;LET USER CONTINUE
16300		JRA 16,1(16)
16400	;CALL GETFI2(<FILE>,<0 OR -1>)  0=DAT,LCS  -1=WHERE YOU ARE., -2=MSS,MUS(HELP)
16500	
16600	GETFI2:	0	; USES CH3
16700		MOVE 0,@0(16)
16800		MOVEM 0,FILNAM
16900		MOVE 0,@1(16)
17000		MOVEM 0,PPNW#
17100		PUSHJ 17,INTFIZ
17200		MOVE 0,[SIXBIT/DMD/]
17300		MOVEM 0,DIR+1
17400	GETFL:	JSA 16,LKUP
17500		SKIPA
17600		JRST GETF3
17700		SETZM DIR+1
17800		JSA 16,LKUP
17900		SKIPA
18000	GETF3:	JRA 16,2(16)
18100		MOVEI 1
18200		MOVEM @1(16)	;SEND BACK A 1 IN 2ND ARGUMENT IF FILE NOT FOUND.
18300		JRA 16,2(16)
18400	
18500	LKUP:	0
18600		SETZM DIR+2
18700		SETZM DIR+3
18800		SKIPE PPNW	;0=DAT,LCS    NON-ZERO = WHERE EVER YOU ARE
18900		JRST LUP
19000		MOVE 0,[SIXBIT/DATLCS/]
19100		JRST LUP3
19200	LUP:	MOVN 0,PPNW
19300		CAIE 0,2	;-2=MSS,MUS
19400		JRST LUP2
19500	     	MOVE 0,[SIXBIT/MSSMUS/]		
19600	LUP3:	MOVEM 0,DIR+3		;PUTS AWAY THE PPN
19700	LUP2:	LOOKUP CH3,DIR
19800		JRA 16,0(16)
19900		JRA 16,1(16)
20000	
20100	INTFIZ:	MOVEI REGS	;INITS DSK FOR INPUT
20200		BLT REGS+3
20300		INIT CH3,17
20400		SIXBIT/DSK/
20500		0
20600		ERROR <CAN'T INIT DSK!>
20700		JRST INTF4
     

09900	TYPSTR:	0		;CALL TYPSTR(STRING)
10000		OUTSTR @(16)	;TYPES OUT A STRING
10100		JRA 16,1(16)  ;THIS WILL TYPE IN GROUPS OF 5 CHARS ALWAYS!!!
10200	
10300	TYPCHR:	0		;CALL TYPCHR(STRING,CHAR COUNT)
10400		SKIPL 1,@1(16)
10500		JRST TYPCH2
10600		OUTSTR @(16)
10700	TYPCH1:	JRA 16,2(16)
10800	TYPCH2:	MOVSI 2,440700
10900		HRRI 2,@(16)
11000	TYPCH3:	SOJL 1,TYPCH1
11100		ILDB 3,2
11200		OUTCHR 3
11300		JRST TYPCH3
11400	
11500	TYPWRD:	0		;CALL TYPWRD(WORD)   ASSUMES ≤5 CHARS.
11600		MOVSI 2,440700
11700		HRRI 2,@(16)
11800		MOVEI 1,5
11900	TYPWR1:	ILDB 3,2
12000		OUTCHR 3
12100		SOJG 1,TYPWR1
12200		JRA 16,1(16)
12300	
12400	TYPCRLF:	0	;CALL TYPCRLF TYPES A CRLF
12500		OUTSTR [ASCIZ /
12600	/]
12700		JRA 16,(16)
12800	
12900	TYPINT:	0  		;CALL TYPINT(INTEGER)
13000		SKIPGE 1,@(16)	;TYPES OUT INTEGERS
13100		OUTCHR ["-"]
13200		MOVMS 1
13300		PUSHJ 17,DECREC
13400		JRA 16,1(16)
13500	DECREC:	IDIVI 1,=10
13600		HRLM 2,(17)
13700		SKIPE 1
13800		PUSHJ 17,DECREC
13900		HLRZ 1,(17)
14000		ADDI 1,"0"
14100		OUTCHR 1
14200		POPJ 17,
14300	
14400	TYPFLT:	0			;CALL TYPFLT(F)
14500		MOVM 4,@(16)	;NEEDS ACS 1→5  **** PRINTS ONLY TO 2 DECIS.
14600		KIFIX 3,@(16)
14700		FMPR 4,[100.0]		;TO GET THINGS TO RT. OF DEC.
14800	;;*** CAUSES 199.997 TO PRINT AS 199 **	FADR 4,[0.5]		;FOR ROUND OFF.
14900		KIFIX 4,4
15000		IDIVI 4,=100		;REMAINDER IS IN AC6
15100		JUMPN 3,TYPFL1		;JUMP IF LFT SIDE .NE.0
15200		SKIPGE @(16)		;IS ORIGINAL NUM. NEG?
15300		OUTCHR ["-"]		;YES
15400		OUTCHR ["0"]
15500		JRST .+3		;PRINT A ZERO AND SKIP NEXT CALL
15600	TYPFL1:	JSA 16,TYPINT
15700		JUMP 3
15800		SKIPN 5		;PRINT NO MORE IF ONLY ZEROS
15900		JRA 16,1(16)
16000		OUTCHR ["."]	;DECIMAL PT.
16100	;;	CAIGE 5,=100
16200	;;	OUTCHR["0"]	;FOR ZERO AFTER DECI
16300		CAIGE 5,=10 
16400		OUTCHR["0"]	;FOR  ZERO AFTER DECI
16500	;;	MOVE 3,5
16600	;;	IDIVI 3,=100
16700	;;	JUMPE 4,DECI	;LOOK AT REMAINDER, JUMP IF NON-ZERO
16800		MOVE 3,5
16900		IDIVI 3,=10
17000		SKIPE 4      	;LOOK AT REMAINDER, JUMP IF NON-ZERO
17100		MOVE 3,5	;ELSE PRINT ALL 3 DIGITS
17200	DECI:	JSA 16,TYPINT
17300		JUMP 3
17400		JRA 16,1(16)
17500	
17600		END